home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-11 / butt01.zip / BPTEST.PRG < prev    next >
Text File  |  1993-01-04  |  13KB  |  372 lines
  1. * Program.: BPTEST.PRG
  2. * Author..: Charles Alan Butler    
  3. * Date....: 04/04/90
  4. * Notice..: Copyright (c) 1990,MIS Consulting, All Rights Reserved
  5. * Notes...: Template Button Menu Ver(1) 4/4/90 *CAB*
  6. * Notes...: Target Language is FoxPro.
  7. ****  Debug  *****
  8. DO set_fox
  9. DO mis_logo
  10. ****  Debug  *****
  11. ** -- Save some of the calling environment
  12. ButtSch1=SCHEME(1)  &&  SAVE Colors   [FoxPro]
  13. ButtSch2=SCHEME(2)  &&  SAVE Colors   [FoxPro]
  14. **  --  Declare private variables
  15. PRIVATE ButRef,ButtColor,ButtScrn,cnt,ColorStr,LastColor
  16. PRIVATE Mpt,MaxMpt,SayString
  17.  
  18. DIMENSION GroupFlag(17)
  19. **  Flag Groups as follows
  20. **  Value of  1 to n  = Radio Button Groups
  21. **  Value of  0 = Check Box
  22. **  Value of -1 = Proceed Text Button
  23. **  Value of -2 = Abort Text Button
  24. **  Value of -3 = Menu Choice Text Button
  25. GroupFlag( 1)=1     &&  Button Group
  26. GroupFlag( 2)=1     &&  Button Group
  27. GroupFlag( 3)=2     &&  Button Group
  28. GroupFlag( 4)=2     &&  Button Group
  29. GroupFlag( 5)=3     &&  Button Group
  30. GroupFlag( 6)=3     &&  Button Group
  31. GroupFlag( 7)=3     &&  Button Group
  32. GroupFlag( 8)=4     &&  Button Group
  33. GroupFlag( 9)=4     &&  Button Group
  34. GroupFlag(10)=4     &&  Button Group
  35. GroupFlag(11)=0     &&  Check Box
  36. GroupFlag(12)=0     &&  Check Box
  37. GroupFlag(13)=0     &&  Check Box
  38. GroupFlag(14)=0     &&  Check Box
  39. GroupFlag(15)=-3    &&  Menu Item
  40. GroupFlag(16)=-1    &&  Proceed
  41. GroupFlag(17)=-2    &&  ESCape
  42.  
  43. **  Set true defaults, one per Radio Group
  44. IF TYPE('T_F(17)') # 'L'  && Skip if already defined   RELEASE T_F
  45.    PUBLIC T_F(17)
  46.    T_F( 2)=.T.   &&  Button Group 1
  47.    T_F( 3)=.T.   &&  Button Group 2
  48.    T_F( 5)=.T.   &&  Button Group 3
  49.    T_F( 9)=.T.   &&  Button Group 4
  50.    T_F(11)=.T.   &&  Check Box
  51. ENDIF
  52.  
  53. IF TYPE('Ky') # 'N'  && Skip if already defined
  54.    RELEASE Ky
  55.    PUBLIC Ky         &&  Returns the ASCII number of the exit key
  56. ENDIF
  57.  
  58. DIMENSION SayAry(17)    &&  --  Array Used to Display Choices  --
  59. DIMENSION HotKey(17)    &&  --  Array Used to Display Hot Keys  --
  60. SayAry( 1)='@  2, 3 SAY "( ) ALL         "'
  61. HotKey(1) = "A 7r+/n"
  62. SayAry( 2)='@  3, 3 SAY "( ) Select      "'
  63. SayAry( 3)='@  2,25 SAY "( ) Incomplete Jobs"'
  64. SayAry( 4)='@  3,25 SAY "( ) All Jobs       "'
  65. HotKey(4) = "J33r+/n"
  66. SayAry( 5)='@  6, 3 SAY "( ) Subdivision "'
  67. SayAry( 6)='@  7, 3 SAY "( ) Address     "'
  68. SayAry( 7)='@  8, 3 SAY "( ) Job Number  "'
  69. SayAry( 8)='@  6,25 SAY "( ) Printer        "'
  70. HotKey(8) = "P29r+/n"
  71. SayAry( 9)='@  7,25 SAY "( ) Screen         "'
  72. SayAry(10)='@  8,25 SAY "( ) File           "'
  73. SayAry(11)='@ 11, 3 SAY "[ ] Balance Due"'
  74. SayAry(12)='@ 12, 3 SAY "[ ] Phone Number"'
  75. HotKey(12) = "o 9gr+/n"
  76. SayAry(13)='@ 11,25 SAY "[ ] Projected Bala"'
  77. SayAry(14)='@ 12,25 SAY "[ ] Projected Cost"'
  78. SayAry(15)='@ 13,15 SAY "{Menu Button}"'
  79. HotKey(15) = "M16w+/n"
  80. SayAry(16)='@ 14, 6 SAY "« PROCEED »"'
  81. SayAry(17)='@ 14,29 SAY "< CANCEL >"'
  82. HotKey(17) = "C31w+/n"
  83. HotKeys = "A..J...P...O..M.C"
  84.  
  85. **  --  Color of Menu Choice  --
  86. DIMENSION SayColor(17)
  87. SayColor( 1)='BG+/N'
  88. SayColor( 2)='BG+/N'
  89. SayColor( 3)='BG+/N'
  90. SayColor( 4)='BG+/N'
  91. SayColor( 5)='BG+/N'
  92. SayColor( 6)='BG+/N'
  93. SayColor( 7)='BG+/N'
  94. SayColor( 8)='BG+/N'
  95. SayColor( 9)='BG+/N'
  96. SayColor(10)='BG+/N'
  97. SayColor(11)='BR+/N'
  98. SayColor(12)='BR+/N'
  99. SayColor(13)='BR+/N'
  100. SayColor(14)='BR+/N'
  101. SayColor(15)='R+/N'
  102. SayColor(16)='GR+/N'
  103. SayColor(17)='GR+/N'
  104.  
  105. * --- Paints titles & borders on the screen
  106. SET COLOR TO G+/N
  107. **  --  Set Size of Display Windows  --  **
  108. DEFINE WINDOW Button FROM 6,16 TO 21,62 none
  109. ACTIVATE WINDOW Button 
  110. @ 0,0,15,46 BOX "╔═╗║╝═╚║ "
  111. @  0, 7 SAY "[ Projection Report Print Options ]"
  112. SET COLOR TO W+/N
  113. @  1, 3 SAY "*- Contractors -*"
  114. @  1,25 SAY "*- Job Selection -*"
  115. @  5,27 SAY "*- Output To -*"
  116. @  5, 4 SAY "*- Sort By -*"
  117. @ 10,10 SAY "*- Include In Report -*"
  118. @  0, 0 SAY CHR(254)   &&  Close window icon
  119. **  --  Local Variables
  120. Mpt = 1        &&  Menu Pointer
  121. MptMax = 17    &&  Last Menu Choice
  122. LastColor=''   &&  Last Color Set
  123.  
  124. cnt =1
  125. DO WHILE cnt <= MptMax        &&  Display Menu Choices
  126.    IF GroupFlag(cnt) < 0      &&  Re-set text button flags
  127.       T_F(cnt) = .F.
  128.    ENDIF
  129.    IF GroupFlag(cnt) >= 0
  130.       SayAry(cnt)=STUFF(SayAry(cnt),15,1,IIF(T_F(cnt),IIF(GroupFlag(cnt)=0,'X','*'),' '))
  131.    ENDIF
  132.    IF LastColor # SayColor(cnt)
  133.       SET COLOR TO &SayColor(cnt)
  134.       LastColor = SayColor(cnt)
  135.    ENDIF
  136.    &SayAry(cnt)
  137.    IF SUBSTR(HotKeys,cnt,1) # '.'      &&  Display Hot Key
  138.       ColorStr = SUBSTR(HotKey(cnt),4)
  139.       SET COLOR TO &ColorStr
  140.       @ ROW(),VAL(SUBSTR(HotKey(cnt),2,2)) SAY SUBSTR(HotKey(cnt),1,1)
  141.       LastColor = ColorStr
  142.    ENDIF
  143.  
  144.    cnt = cnt +1
  145. ENDDO
  146.  
  147. DO WHILE .T.
  148.    **  ----------  Display Highlite and get key press  ------------
  149.    SET COLOR TO w+/r
  150.    &SayAry(Mpt)                  &&  Display Highlite
  151.    Ky = INKEY(0,'MH')            &&  Get Key Press   ******************
  152.    SET COLOR TO &SayColor(Mpt)   &&  Color
  153.    &SayAry(Mpt)                  &&  Turn Highlite Off
  154.    IF SUBSTR(HotKeys,Mpt,1) # '.'      &&  Display Hot Key
  155.       ColorStr = SUBSTR(HotKey(Mpt),4)
  156.       SET COLOR TO &ColorStr
  157.       @ ROW(),VAL(SUBSTR(HotKey(Mpt),2,2)) SAY SUBSTR(HotKey(Mpt),1,1)
  158.       LastColor = ColorStr
  159.    ENDIF
  160.    IF Ky = 151    &&  Mouse Click, so decode
  161.       Ky = 13
  162.       DO CASE
  163.       CASE MROW() = 0 .AND. MCOL() = 0
  164.          Ky = 27     &&  ESCape
  165.       CASE MROW() =  2 .AND. MCOL()>=  3 .AND. MCOL() <= 21
  166.          Mpt = 1
  167.       CASE MROW() =  3 .AND. MCOL()>=  3 .AND. MCOL() <= 19
  168.          Mpt = 2
  169.       CASE MROW() =  2 .AND. MCOL()>= 25 .AND. MCOL() <= 44
  170.          Mpt = 3
  171.       CASE MROW() =  3 .AND. MCOL()>= 25 .AND. MCOL() <= 46
  172.          Mpt = 4
  173.       CASE MROW() =  6 .AND. MCOL()>=  3 .AND. MCOL() <= 19
  174.          Mpt = 5
  175.       CASE MROW() =  7 .AND. MCOL()>=  3 .AND. MCOL() <= 19
  176.          Mpt = 6
  177.       CASE MROW() =  8 .AND. MCOL()>=  3 .AND. MCOL() <= 19
  178.          Mpt = 7
  179.       CASE MROW() =  6 .AND. MCOL()>= 25 .AND. MCOL() <= 46
  180.          Mpt = 8
  181.       CASE MROW() =  7 .AND. MCOL()>= 25 .AND. MCOL() <= 44
  182.          Mpt = 9
  183.       CASE MROW() =  8 .AND. MCOL()>= 25 .AND. MCOL() <= 44
  184.          Mpt = 10
  185.       CASE MROW() = 11 .AND. MCOL()>=  3 .AND. MCOL() <= 18
  186.          Mpt = 11
  187.       CASE MROW() = 12 .AND. MCOL()>=  3 .AND. MCOL() <= 21
  188.          Mpt = 12
  189.       CASE MROW() = 11 .AND. MCOL()>= 25 .AND. MCOL() <= 43
  190.          Mpt = 13
  191.       CASE MROW() = 12 .AND. MCOL()>= 25 .AND. MCOL() <= 43
  192.          Mpt = 14
  193.       CASE MROW() = 13 .AND. MCOL()>= 15 .AND. MCOL() <= 30
  194.          Mpt = 15
  195.       CASE MROW() = 14 .AND. MCOL()>=  6 .AND. MCOL() <= 17
  196.          Mpt = 16
  197.       CASE MROW() = 14 .AND. MCOL()>= 29 .AND. MCOL() <= 41
  198.          Mpt = 17
  199.       OTHERWISE
  200.          LOOP
  201.       ENDCASE
  202.    ENDIF Ky = 151    &&  Mouse Click
  203.  
  204.    **  --  Test for Hot Key  --
  205.    IF Ky > 32 .AND. Ky < 127     &&  ASCII key pressed
  206.       IF Ky > 96
  207.          Ky = Ky -32 &&  Convert to Upper Case
  208.       ENDIF
  209.       IF CHR(Ky) $ HotKeys       &&  Hot Key found
  210.          Mpt = AT(CHR(Ky),HotKeys)
  211.          Ky =32
  212.       ENDIF
  213.    ENDIF
  214.  
  215.    **  ----------------  Process KEY strokes  ---------------------
  216.    DO CASE
  217.    CASE Ky=5.OR.Ky=56.OR.Ky=19.OR.Ky=52            &&  [Up]  [Left]
  218.       Mpt = IIF(Mpt=1,MptMax,Mpt-1)
  219.  
  220.    CASE Ky=24.OR.Ky=50.OR.Ky=4.OR.Ky=54            &&  [Down]  [Right]
  221.       Mpt = IIF(Mpt=MptMax,1,Mpt+1)
  222.  
  223.    CASE Ky = 9                                     &&  Tab to next group
  224.       cnt = Mpt
  225.       ButRef = GroupFlag(Mpt)
  226.       DO WHILE cnt <= MptMax
  227.          IF GroupFlag(cnt) # ButRef
  228.             Mpt = cnt
  229.             EXIT
  230.          ENDIF
  231.          cnt = cnt +1
  232.       ENDDO
  233.       Mpt = IIF(cnt>MptMax,1,Mpt)
  234.  
  235.    CASE Ky = 15                                    &&  Shift Tab prev group
  236.       cnt = Mpt
  237.       ButRef = GroupFlag(Mpt)
  238.       DO WHILE cnt >= 1
  239.          IF GroupFlag(cnt) # ButRef
  240.             Mpt = cnt
  241.             EXIT
  242.          ENDIF
  243.          cnt = cnt -1
  244.       ENDDO
  245.       Mpt = IIF(cnt<1,MptMax,Mpt)
  246.  
  247.    CASE Ky = 27                                    &&  ESCape
  248.       T_F(17) = .T.
  249.          acti scre
  250.          do MsgError with 'w+/r',24,'This is a test call upon Escape exit.'
  251.       EXIT     &&  --  MENU Exit to abort
  252.  
  253.    CASE Ky = 23 .OR. Ky = 10                       &&  Ctrl-End or Ctrl-Enter
  254.       Ky = 10     &&  Force to Ctrl-Enter code
  255.       T_F(16) = .T.
  256.       EXIT     &&  --  MENU Exit to proceed
  257.  
  258.    CASE Ky=28.OR.Ky=72.OR.Ky=104                   &&  [F1] [Hh]  Help
  259.       **  put up the window
  260.       SET COLOR TO RB+/N
  261.       DEFINE WINDOW ButHelp FROM 2,10 TO 20,68  ;
  262.              TITLE '[ Control Panel Help ]' DOUBLE ;
  263.              COLOR G+/N,RB+/N,RB+/N
  264.       ACTIVATE WINDOW ButHelp
  265.       @ ROW()+1,2 SAY 'The following keys are active while using this panel.'
  266.       @ ROW()+1,2 SAY '--------KEY------ACTION------------------------------'
  267.       @ ROW()+1,2 SAY '      [Enter]  Select the item highlighted.'
  268.       @ ROW()+1,2 SAY '      [Space]  Select the item highlighted.'
  269.       @ ROW()+1,2 SAY '[Ctrl][Enter]  Exit the menu and proceed.'
  270.       @ ROW()+1,2 SAY '  [Ctrl][End]  Exit the menu and proceed.'
  271.       @ ROW()+1,2 SAY '        [ESC]  Exit without selecting.'
  272.       @ ROW()+1,2 SAY '     [Arrows]  Up/Down, move the highlighted item.'
  273.       @ ROW()+1,2 SAY '     [Arrows]  Right/Left, move the highlighted item.'
  274.       @ ROW()+1,2 SAY '        [Tab]  Move Highlight forward one group'
  275.       @ ROW()+1,2 SAY ' [Shift][Tab]  Move Highlight back one group'
  276.       @ ROW()+1,2 SAY '       [Home]  Go to the first item.'
  277.       @ ROW()+1,2 SAY '        [End]  Go to the last item.'
  278.       @ ROW()+1,2 SAY '         [F1]  Displays this screen.'
  279.       @ ROW()+1,2+14 SAY '<Press Any Key To Return>'
  280.       cnt=INKEY(0,'HM')
  281.       RELEASE WINDOWS ButHelp
  282.       ACTIVATE WINDOW Button
  283.  
  284.    CASE Ky = 1 .OR. Ky = 55                        &&  Home
  285.       Mpt = 1
  286.  
  287.    CASE Ky = 6 .OR. Ky = 49                        &&  End
  288.       Mpt = MptMax
  289.  
  290.    CASE Ky = 13 .OR. Ky = 32                       &&  ENTER or SPACE
  291.       IF GroupFlag(Mpt) >= 0   &&  Is Button or Check Box
  292.          **  No action if Button is ON
  293.          IF GroupFlag(Mpt) = 0 .OR. .NOT. T_F(Mpt)
  294.  
  295.             DO CASE      &&  Tag Action Initiated Here
  296.             CASE Mpt=1
  297.                hide wind Button
  298.                activate screen
  299.                save scre
  300.                do nothing
  301.                rest scre
  302.                ACTIVATE WINDOW Button
  303.             CASE Mpt=4
  304.                activate screen
  305.                DO Msg24 with "This is a test call to Msg24.Prg from a button."
  306.                ans=Inkey(5)
  307.                ACTIVATE WINDOW Button
  308.             CASE Mpt=8
  309.                hide wind Button
  310.                acti scre
  311.                save scre
  312.                Do Nothing
  313.                rest scre
  314.                ACTIVATE WINDOW Button
  315.             CASE Mpt=12
  316.                acti scre
  317.                Do Msg24 with "This is a test call to Msg24.prg from a check box."
  318.                ans=Inkey(5)
  319.                ACTIVATE WINDOW Button
  320.             ENDCASE
  321.  
  322.             **  Set True / False Flag
  323.             T_F(Mpt) = IIF(GroupFlag(Mpt)#0,.T.,.NOT.T_F(Mpt))
  324.  
  325.             **  Set  display of button On or Off
  326.             SayAry(Mpt)=STUFF(SayAry(Mpt),15,1,IIF(T_F(Mpt),IIF(GroupFlag(Mpt)=0,'X','*'),' '))
  327.  
  328.             **  If Button, Need to clear all buttons in this group
  329.             IF GroupFlag(Mpt) # 0   && Ignore if Check Box
  330.                ButRef= GroupFlag(Mpt)   &&  Button Reference
  331.                cnt =1
  332.                DO WHILE cnt <= MptMax
  333.                   IF GroupFlag(cnt) = ButRef      &&  Button group match
  334.                      IF cnt # Mpt      &&  Clear Button
  335.                         T_F(cnt) = .F.
  336.                         SayAry(cnt)=STUFF(SayAry(cnt),15,1,' ')
  337.                      ENDIF
  338.                      ColorStr = SayColor(cnt)
  339.                      IF LastColor # ColorStr
  340.                         SET COLOR TO &ColorStr
  341.                         LastColor = ColorStr
  342.                      ENDIF
  343.                      SayString = LEFT(SayAry(cnt),15)+'"'
  344.                      &SayString             &&  Display Menu Choice
  345.                   ENDIF
  346.                   cnt = cnt +1
  347.                ENDDO
  348.             ENDIF
  349.          ENDIF
  350.       ELSE              &&  EXIT or Menu Choice
  351.          DO CASE
  352.          CASE Mpt=15
  353.             acti scre
  354.             Do Msg24 with 'Menu Button for a prg call if you like.'
  355.             ans=Inkey(5)
  356.             ACTIVATE WINDOW Button
  357.          CASE GroupFlag(Mpt) = -1
  358.             KEYBOARD CHR(10)
  359.          CASE GroupFlag(Mpt) = -2
  360.             KEYBOARD CHR(27)
  361.          ENDCASE
  362.       ENDIF
  363.    ENDCASE
  364. ENDDO    &&  ------------------ Main Loop ---------------------------
  365.  
  366. * ---Closing operations.
  367. RELEASE WINDOW Button
  368. SET COLOR OF SCHEME 1 TO &ButtSch1  &&  Restore Colors   [FoxPro]
  369. SET COLOR OF SCHEME 2 TO &ButtSch2  &&  Restore Colors   [FoxPro]
  370. RETURN
  371. * EOF: BPTEST.PRG
  372.